perm filename WINGS[CRE,BGB] blob
sn#020179 filedate 1973-01-16 generic text, type T, neo UTF8
00100 TITLE WINGS - THE WINGED EDGE SUBROUTINES - JULY 1972.
00200 COMMENT/ --- MODIFIED FOR CART'S EYE ----- 1 JANUARY 1973.
00300
00400 B ← BODY(Q);
00500 FNEW ← MKF(B); KLF(FNEW);
00600 ENEW ← MKE(B); KLE(ENEW);
00700 VNEW ← MKV(B); KLV(VNEW);
00800
00900 WING(E1,E2); LINKED(Q1,Q2);
01000
01100 E ← ELEFT(V,F); E ← ERIGHT(V,F);
01200 E ← ECW(E,Q); E ← ECCW(E,Q);
01300 Q ← OTHER(E,Q); OTHER.(A,E,Q);
01400
01500 F ← FCW(E,V); F ← FCCW(E,V);
01600 V ← VCW(E,F); V ← VCCW(E,F);
01700 -----------------------------------------------------------------/
01800
01900
02000 EXTERN MAKE,KILL
02100
02200 SUBR(BODY)Q-------------------------------------------------------
02300 BEGIN BODY; BODY ≡ IMAGE FETCH - BGB - 1 JAN 73.
02400 Q←1
02500 LAC Q,ARG1
02600 TESTZ Q,VBIT↔PED Q,Q
02700 TESTZ Q,EBIT↔PFACE Q,Q
02800 TESTZ Q,FBIT↔DAD Q,Q
02900 TEST Q,IBIT↔SETZ Q,
03000 POP1J
03100 BEND;1/1/73-------------------------------------------------------
00100 ;FACE, EDGE & VERTEX MAKE PRIMITIVES.
00200 ;ACCUMULATOR TRANSPARENT AC2-AC17.
00300 ;READ IMAGE NODE FOR BODY NODE.
00400
00500 SUBR(MKF)B--------------------------------------------------------
00600 BEGIN MKF
00700 Q←1 ↔ X←2 ↔ B←3
00800 CALL(MAKE,[FBIT+FREL])
00900 EXCH B,ARG1↔LAC X
01000 DAD. B,Q
01100 NFACE X,B
01200 PFACE. Q,X↔NFACE. Q,B
01300 PFACE. B,Q↔NFACE. X,Q
01400 EXCH B,ARG1↔EXCH X↔POP1J
01500 BEND;1/1/73-------------------------------------------------------
01600
01700 SUBR(MKE)B--------------------------------------------------------
01800 BEGIN MKE
01900 Q←1 ↔ X←2 ↔ B←3
02000 CALL(MAKE,[EBIT+EREL])
02100 EXCH B,ARG1↔LAC X
02200 NED X,B
02300 PED. Q,X↔NED. Q,B
02400 PED. B,Q↔NED. X,Q
02500 EXCH B,ARG1↔EXCH X↔POP1J
02600 BEND;1/1/73-------------------------------------------------------
02700
02800 SUBR(MKV)B--------------------------------------------------------
02900 BEGIN MKV
03000 Q←1 ↔ X←2 ↔ B←3
03100 CALL(MAKE,[VBIT+VREL])
03200 EXCH B,ARG1↔LAC X
03300 NVT X,B
03400 PVT. Q,X↔NVT. Q,B
03500 PVT. B,Q↔NVT. X,Q
03600 EXCH B,ARG1↔EXCH X↔POP1J
03700 BEND;1/1/73-------------------------------------------------------
00100 SUBR(KLF)FNEW-----------------------------------------------------
00200 BEGIN KLF;KILL FACE - BGB - 2 JAN 73.
00300 SKIPN 1,ARG1↔POP1J↔DAC 2,TMP#
00400 NFACE 2,1↔PFACE 1,1 ;DELETE FROM FACE RING.
00500 NFACE. 2,1↔PFACE. 1,2
00600 CALL KILL,ARG1
00700 LAC 2,TMP↔POP1J
00800 BEND;1/2/73-------------------------------------------------------
00900
01000 SUBR(KLE)ENEW-----------------------------------------------------
01100 BEGIN KLE;KILL EDGE - BGB - 2 JAN 73.
01200 SKIPN 1,ARG1↔POP1J↔DAC 2,TMP#
01300 NED 2,1↔PED 1,1 ;DELETE FROM EDGE RING.
01400 NED. 2,1↔PED. 1,2
01500 CALL KILL,ARG1
01600 LAC 2,TMP↔POP1J
01700 BEND;1/2/73-------------------------------------------------------
01800
01900 SUBR(KLV)---------------------------------------------------------
02000 BEGIN KLV;KILL VERTEX - BGB - 2 JAN 73.
02100 SKIPN 1,ARG1↔POP1J
02200 TESTZ 1,ARCBIT↔POP1J ;DON'T KILL ARC VERTICES.
02300 EXCH 2
02400 NVT 2,1↔PVT 1,1 ;DELETE FROM VERTEX RING.
02500 NVT. 2,1↔PVT. 1,2
02600 CALL KILL,ARG1
02700 EXCH 2↔POP1J
02800 BEND;1/2/73-------------------------------------------------------
00100 SUBR(WING)E1,E2---------------------------------------------------
00200 BEGIN WING; - BGB - 1 JAN 73.
00300 ;WING(E1,E2) place wing pointers between two edges.
00400 ;THE AC-0 CONTROL BITS:
00500 ;[0-NV2-NV1] [0-PV2-PV1] [0-NF2-NF1] [0-PF2-PF1]
00600 E1←3 ↔ E2←4
00700 SAVAC(4)↔SETZ↔CDR E1,ARG2↔CDR E2,ARG1
00800
00900 ;FIND THE COMMON VERTEX.
01000 ; AC-1 ← (NV1,,PV1) ⊗ (NV2,,PV2) NN,,PP in common.
01100 ; AC-2 ← (PV1,,NV1) ⊗ (NV2,,PV2) PN,,NP in common.
01200
01300 LAC 1,5(E1)↔MOVS 2,1↔XOR 1,5(E2)↔XOR 2,5(E2)
01400 TLNN 1,-1↔TRO 3000↔TRNN 1,-1↔TRO 0300
01500 TLNN 2,-1↔TRO 2100↔TRNN 2,-1↔TRO 1200
01600
01700 ;FIND THE COMMON FACE.
01800
01900 LAC 1,3(E1)↔MOVS 2,1↔XOR 1,3(E2)↔XOR 2,3(E2)
02000 TLNN 1,-1↔TRO 0030↔TRNN 1,-1↔TRO 0003
02100 TLNN 2,-1↔TRO 0021↔TRNN 2,-1↔TRO 0012
02200
02300 ;STORE THE WINGS AS INDICATED.
02400
02500 SETCA
02600 TRNN 2020↔NCW. E1,E2↔TRNN 1010↔NCW. E2,E1
02700 TRNN 2002↔PCCW. E1,E2↔TRNN 1001↔PCCW. E2,E1
02800 TRNN 0220↔NCCW. E1,E2↔TRNN 0110↔NCCW. E2,E1
02900 TRNN 0202↔PCW. E1,E2↔TRNN 0101↔PCW. E2,E1
03000 GETAC(4)↔POP2J
03100 BEND;1/1/73-------------------------------------------------------
00100 ;LINKED(Q1,Q2) - DETERMINE WHETHER TWO FEV ENTITIES ARE LINKED.
00200 SUBR(LINKED)------------------------------------------------------
00300 BEGIN LINKED
00400 ACCUMULATORS{Q1,Q2,E}
00500 CDR Q1,ARG2↔CDR Q2,ARG1
00600 ;BRANCH ON THE COMBINATION OF ARGUMENT TYPES.
00700 TESTZ Q2,FBIT↔EXCH Q1,Q2
00800 TEST Q1,FBIT↔GO L1 ;POTENTIAL FACE NOW IN Q1.
00900 TESTZ Q2,FBIT↔GO FF
01000 TESTZ Q2,EBIT↔GO FE
01100 TESTZ Q2,VBIT↔GO FV↔GO FALSE
01200 L1: TESTZ Q2,EBIT↔EXCH Q1,Q2
01300 TEST Q1,EBIT↔GO L2 ;POTENTIAL EDGE NOW IN Q1.
01400 TESTZ Q2,EBIT↔GO EE
01500 TESTZ Q2,VBIT↔GO EV↔GO FALSE
01600 L2: TEST Q1,VBIT↔GO FALSE
01700 TEST Q2,VBIT↔GO FALSE↔GO VV
01800
01900 ;FACES WITH COMMON EDGE.
02000 FF: PED E,Q1↔DAC E,E0#
02100 CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE
02200 SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO FF+2↔GO FALSE
02300
02400 ;EDGE IN FACE PERIMETER.
02500 FE: PFACE 1,Q2↔CAMN 1,Q1↔GO TRUE
02600 NFACE 1,Q2↔CAMN 1,Q1↔GO TRUE↔GO FALSE
02700
02800 ;VERTEX IN FACE PERIMETER.
02900 FV: PED E,Q2↔DAC E,E0
03000 JUMPE E,[PFACE 1,Q1↔PVT 0,Q2↔CAME 0,1↔GO FALSE↔GO TRUE]
03100 PFACE 1,E↔CAMN 1,Q1↔GO TRUE↔NFACE 1,E↔CAMN 1,Q1↔GO TRUE
03200 SETQ(E,{ECCW,E,Q2})↔CAME E,E0↔GO FV+2↔GO FALSE
03300
03400 ;EDGES WITH A COMMON VERTEX.
03500 EE: PVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE
03600 NVT 1,Q2↔CAMN 0,1↔GO TRUE
03700 NVT 0,Q1↔PVT 1,Q2↔CAMN 0,1↔GO TRUE
03800 NVT 1,Q2↔CAMN 0,1↔GO TRUE↔GO FALSE
03900
04000 ;VERTEX IN EDGE.
04100 EV: PVT 1,Q1↔CAMN 1,Q2↔GO TRUE
04200 NVT 1,Q1↔CAMN 1,Q2↔GO TRUE↔GO FALSE
04300
04400 ;VERTICES WITH A COMMON EDGE.
04500 VV: PED E,Q1↔DAC E,E0
04600 CALL OTHER,E,Q1↔CAMN 1,Q2↔GO TRUE
04700 SETQ(E,{ECCW,E,Q1})↔CAME E,E0↔GO VV+2↔GO FALSE
04800
04900 FALSE: SETZ 1,↔POP2J
05000 TRUE: SETO 1,↔POP2J
05100 LIT↔VAR
05200 BEND;1/1/73-------------------------------------------------------
00100 SUBR(ERIGHT)------------------------------------------------------
00200 TDCA 1,1 ;E ← ERIGHT(FROM-V,ABOUT-F).
00300 SUBR(ELEFT)-------------------------------------------------------
00400 SETZ 1, ;E ← ELEFT(FROM-V,ABOUT-F).
00500 ; ELEFT ←-------V-------→ ERIGHT
00600 ; | |
00700 ; | F |
00800 ; | |
00900 BEGIN EFETCH
01000 ACCUMULATORS{V,F,E1,E2}
01100 Q←1
01200 SAVAC(5)
01300 DAC Q,QFLAG#↔LAC V,ARG2↔LAC F,ARG1
01400 TEST V,VBIT↔GO[SETCMM QFLAG↔EXCH F,V↔GO .+1]
01500 PED E2,V↔DAC E2,E0#
01600 L1: LAC E1,E2
01700
01800 ;E2←ECW(E1,V) AND Q←FCW(E1,V).
01900 PVT Q,E1↔CAME Q,V↔GO .+4↔NCCW E2,E1↔NFACE Q,E1↔GO .+6
02000 NVT Q,E1↔CAME Q,V↔GO DIE↔PCCW E2,E1↔PFACE Q,E1
02100 CAMN Q,F↔GO L2↔CAME E2,E0↔GO L1
02200 DIE: FATAL(EFETCH)
02300 L2: LAC 1,E1↔SKIPE QFLAG↔LAC 1,E2
02400 GETAC(5)↔POP2J
02500 BEND;1/1/73-------------------------------------------------------
02600
00100 ;E←ECW(FROM-X,ABOUT-Y) - EDGE CLOCKWISE FROM X ABOUT Y.
00200 SUBR(ECW)---------------------------------------------------------
00300 BEGIN ECW
00400 Q←1 ↔ X←2 ↔ E←3
00500 CDR 1,ARG2↔TEST 1,EBIT↔GO ERIGHT
00600 DAC 2,AC2↔ DAC 3,AC3
00700 CDR X,ARG1↔LAC E,1
00800 TEST X,VBIT↔GO[
00900 PFACE Q,E↔CAME Q,X↔GO L1↔ PCW Q,E↔GO L
01000 L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ NCW Q,E↔GO L]
01100 PVT Q,E↔CAME Q,X↔GO L2↔ NCCW Q,E↔GO L
01200 L2: NVT Q,E↔CAME Q,X↔GO DIE↔ PCCW Q,E↔GO L
01300 DIE: FATAL(ECW)
01400 L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
01500 LIT
01600 BEND;1/1/73-------------------------------------------------------
01700
01800 SUBR(ECCW)--------------------------------------------------------
01900 BEGIN ECCW
02000 Q←1 ↔ X←2 ↔ E←3
02100 CDR 1,ARG2↔TEST 1,EBIT↔GO ELEFT
02200 DAC 2,AC2↔ DAC 3,AC3
02300 CDR X,ARG1↔LAC E,1
02400 TEST X,VBIT↔GO[
02500 PFACE Q,E↔CAME Q,X↔GO L1↔ PCCW Q,E↔GO L
02600 L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ NCCW Q,E↔GO L]
02700 PVT Q,E↔CAME Q,X↔GO L2↔ PCW Q,E↔GO L
02800 L2: NVT Q,E↔CAME Q,X↔GO DIE↔ NCW Q,E↔GO L
02900 DIE: FATAL(ECCW)
03000 L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
03100 LIT
03200 BEND;1/1/73-------------------------------------------------------
00100 SUBR(OTHER)-------------------------------------------------------
00200 BEGIN OTHER
00300 Q←1 ↔ X←2 ↔ E←3
00400 DAC 2,AC2↔ DAC 3,AC3
00500 CDR X,ARG1↔CDR E,ARG2
00600 TEST X,VBIT↔GO[
00700 PFACE Q,E↔CAME Q,X↔GO L1↔ NFACE Q,E↔GO L
00800 L1: NFACE Q,E↔CAME Q,X↔GO DIE↔ PFACE Q,E↔GO L]
00900 PVT Q,E↔CAME Q,X↔GO L2↔ NVT Q,E↔GO L
01000 L2: NVT Q,E↔CAME Q,X↔GO DIE↔ PVT Q,E↔GO L
01100 DIE: FATAL(OTHER)
01200 L: LAC 2,AC2↔ LAC 3,AC3↔ POP2J
01300 LIT
01400 BEND;1/1/73-------------------------------------------------------
01500
01600 ; OTHER.(Q,E,X)
01700 SUBR(OTHER.)------------------------------------------------------
01800 BEGIN OTHER.
01900 Q←1↔ X←2↔ E←3
02000 DAC AC0↔DAC 1,AC1↔DAC 2,AC2↔DAC 3,AC3
02100 CDR X,ARG1↔ CDR E,ARG2↔ CDR Q,ARG3
02200 TEST X,VBIT↔GO[
02300 PFACE 0,E↔ CAME X↔ GO L1↔ NFACE. Q,E↔GO L
02400 L1: NFACE 0,E↔ CAME X↔ GO DIE↔PFACE. Q,E↔GO L]
02500 NVT 0,E↔ CAME X↔ GO L2↔ PVT. Q,E↔GO L
02600 L2: PVT 0,E↔ CAME X↔ GO DIE↔NVT. Q,E↔GO L
02700 DIE: FATAL(OTHER.)
02800 L: LAC AC0↔LAC 1,AC1↔LAC 2,AC2↔LAC 3,AC3
02900 POP3J↔LIT
03000 BEND;1/1/73-------------------------------------------------------
00100 ;V ← VCW(E,F).
00200 SUBR(VCW)---------------------------------------------------------
00300 BEGIN VCW
00400 Q←1 ↔ E←2
00500 DAC 2,AC2
00600 CDR E,ARG2
00700 PFACE Q,E↔CAME Q,ARG1↔GO L1 ↔PVT Q,E↔GO L
00800 L1: NFACE Q,E↔CAME Q,ARG1↔GO DIE↔NVT Q,E↔GO L
00900 DIE: FATAL(VCW)
01000 L: LAC 2,AC2↔POP2J↔LIT
01100 BEND;1/1/73-------------------------------------------------------
01200
01300 ;V ← VCCW(E,F).
01400 SUBR(VCCW)--------------------------------------------------------
01500 BEGIN VCCW
01600 Q←1 ↔ E←2
01700 DAC 2,AC2
01800 CDR E,ARG2
01900 PFACE Q,E↔CAME Q,ARG1↔GO L1 ↔NVT Q,E↔GO L
02000 L1: NFACE Q,E↔CAME Q,ARG1↔GO DIE↔PVT Q,E↔GO L
02100 DIE: FATAL(VCCW)
02200 L: LAC 2,AC2↔POP2J↔LIT
02300 BEND;1/1/73-------------------------------------------------------
02400
02500 ;F ← FCW(E,V).
02600 SUBR(FCW)---------------------------------------------------------
02700 BEGIN FCW
02800 Q←1 ↔ E←2
02900 DAC 2,AC2
03000 CDR E,ARG2
03100 PVT Q,E↔CAME Q,ARG1↔GO L1 ↔NFACE Q,E↔GO L
03200 L1: NVT Q,E↔CAME Q,ARG1↔GO DIE↔PFACE Q,E↔GO L
03300 DIE: FATAL(FCW)
03400 L: LAC 2,AC2↔POP2J↔LIT
03500 BEND;1/1/73-------------------------------------------------------
03600
03700 ;F ← FCCW(E,V).
03800 SUBR(FCCW)--------------------------------------------------------
03900 BEGIN FCCW
04000 Q←1 ↔ E←2
04100 DAC 2,AC2
04200 CDR E,ARG2
04300 PVT Q,E↔CAME Q,ARG1↔GO L1 ↔PFACE Q,E↔GO L
04400 L1: NVT Q,E↔CAME Q,ARG1↔GO DIE↔NFACE Q,E↔GO L
04500 DIE: FATAL(FCCW)
04600 L: LAC 2,AC2↔POP2J↔LIT
04700 BEND;1/1/73-------------------------------------------------------
04800 END